home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / DefDTIcon / ADDTI / AskDDTI.PAS next >
Pascal/Delphi Source File  |  1995-07-11  |  4KB  |  121 lines
  1. program AskDDTI;
  2.  
  3. uses Exec, datatypes, Amiga, AmigaDOS, IFFParse, Intuition, Icon, Workbench;
  4.  
  5. CONST
  6.     Template : String[29] = 'FILE/A,COARSE/S,NODATATYPE/S'#0;
  7.     RD_Array : Array [0..3] of LongInt = (0);
  8.     Ver      : String[25] = 'AskDDTI 1.2 Lee Kindness'#0;
  9.     
  10. VAR
  11.     RDArg  : pRDArgs;
  12.     l, dl1, 
  13.     dl2    : BPTR;
  14.     dt     : pDataType;
  15.     BName, ts,
  16.     IName  : String;
  17.     FName  : STRPTR;
  18.     buf    : String[7];
  19.     OK     : Boolean;
  20.     RemKey : pRemember;
  21.     dobj   : pDiskObject;
  22.  
  23. function CStrConstPtrAR(rk:ppRemember; s : string): STRPTR;
  24.  
  25. var  p : STRPTR;
  26. begin
  27.   s := s + #0;                                    { Make "C" string }
  28.   p := AllocRemember(rk, length(s), MEMF_CLEAR);  { Get some mem for it }
  29.   move(s[1], p^, length(s));                      { Move s into newly alloc'd mem }
  30.   CStrConstPtrAR := p                               { Return the pointer }
  31. end;
  32.  
  33. begin
  34.     RemKey := NIL;
  35.     if pExecBase(SysBase)^.Softver >= 36 then begin
  36.         IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
  37.         IconBase := OpenLibrary('icon.library',36);
  38.         IFFParseBase := OpenLibrary('iffparse.library',36);
  39.         datatypesBase := OpenLibrary('datatypes.library',39);
  40.         if (IntuitionBase <> NIL) and (IFFParseBase <> NIL)
  41.            and (IconBase <> NIL) then begin
  42.             RDArg := NIL;
  43.             RDArg := ReadArgs(@Template[1],@RD_Array,RDArg);
  44.             
  45.             if RD_Array[0] <> 0 then begin
  46.                 l := lock(Pointer(RD_Array[0]), ACCESS_READ);
  47.                 if l <> NULL then begin
  48.                     ok := NameFromLock(l, @ts, 180);
  49.                     dl1 := ParentDir(l);
  50.                     if dl1 = NULL then begin
  51.                         { disk if NULL (root file system) parent }
  52.                         FName := CStrConstPtrAR(@RemKey,PtrToPas(@ts)+'disk');
  53.                     end else begin
  54.                         FName := @ts;
  55.                     end;
  56.                     unlock(dl1);
  57.             
  58.                     dobj := GetDiskObjectNew(FName);
  59.                     
  60.                     if dobj <> NIL then begin
  61.                         if NOT((dobj^.do_Type = WBPROJECT) or (dobj^.do_Type = WBTOOL)) then begin
  62.                             Write('  Would load in system default icon ("');
  63.                             CASE dobj^.do_Type of
  64.                                 WBDISK : Writeln('ENV:Sys/def_disk")');
  65.                                 WBDRAWER : Writeln('ENV:Sys/def_drawer")');
  66.                                 WBGARBAGE : Writeln('ENV:Sys/def_Trashcan")');
  67.                                 WBKICK : Writeln('ENV:Sys/def_kick")');
  68.                             end;
  69.                                 
  70.                         end else begin
  71.                             if (DataTypesBase <> NIL) and (RD_Array[2] = 0) then begin
  72.                                 dl2 := Lock(FName, SHARED_LOCK);
  73.                                 if dl2 <> NULL then begin
  74.                                     dt := ObtainDataTypeA(DTST_FILE, Pointer(dl2), NIL);
  75.                                     if dt <> NIL then begin
  76.                                         if  RD_Array[1] = 0 then begin
  77.                                             if dt^.dtn_Header^.dth_ID = $62696E61 {bina} then
  78.                                                 BName := 'Use sys tool'
  79.                                             else
  80.                                                 BName := PtrToPas(dt^.dtn_Header^.dth_Name);
  81.                                         end else begin
  82.                                             if dt^.dtn_Header^.dth_ID = $62696E61 {bina} then
  83.                                                 BName := 'Use sys tool'
  84.                                             else
  85.                                                 BName := PtrToPas(IDToStr(dt^.dtn_Header^.dth_GroupID ,@buf));
  86.                                         end;
  87.                                     
  88.                                         if BName <> 'Use sys tool' then begin
  89.                                             IName := 'ENV:Sys/def_'+BName;
  90.                                             Writeln('  Would load in "',IName,'"');
  91.                                             if RD_Array[1] = 0 then begin
  92.                                                 IName := 'ENV:Sys/def_'+PtrToPas(dt^.dtn_Header^.dth_BaseName);
  93.                                                 Writeln('  If above was not present "',IName,'" would be loaded');
  94.                                                 IName := 'ENV:Sys/def_'+PtrToPas(IDToStr(dt^.dtn_Header^.dth_GroupID ,@buf));
  95.                                                 Writeln('  If above was not present "',IName,'" would be loaded');
  96.                                             end;
  97.                                             Writeln('  If that failed then the default project icon would be loaded');
  98.                                         end else
  99.                                             Writeln('  Would load in system default icon ("ENV:Sys/def_tool")');
  100.                                         
  101.                                         ReleaseDataType(dt);
  102.                                     end;
  103.                                     unlock(dl2);
  104.                                 end;
  105.                             end else
  106.                                 writeln('  Datatypes not available would load default tool or project'); 
  107.                         end;
  108.                         FreeDiskObject(dobj);
  109.                     end;
  110.                     UnLock(l);
  111.                 end;
  112.             end;
  113.             FreeArgs(RDArg);
  114.             FreeRemember(@RemKey, True);
  115.             CloseLibrary(DataTypesBase);
  116.             CloseLibrary(IFFParseBase);
  117.             CloseLibrary(IconBase);
  118.             CloseLibrary(pLibrary(IntuitionBase));
  119.         end;
  120.     end;
  121. end.